﻿unit unit1;

interface

uses
     //
     dwBase,

     //
     SynCommons,

     //
     Forms,
     Winapi.Windows, Winapi.Messages, System.SysUtils,
  Data.Win.ADODB, Vcl.StdCtrls, Vcl.Controls, Vcl.ExtCtrls, System.Classes, Vcl.Imaging.pngimage,
  Data.DB;

type
  TForm1 = class(TForm)
    Panel_Login: TPanel;
    Button1: TButton;
    Edit_Password: TEdit;
    Edit_User: TEdit;
    Image_bg: TImage;
    Panel5: TPanel;
    Edit_Captcha: TEdit;
    Image_Captcha: TImage;
    Panel2: TPanel;
    Image_Logo: TImage;
    ADOQuery1: TADOQuery;
    Edit_Confirm: TEdit;
    Edit_Mail: TEdit;
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
    Form1   : TForm1;
const
    _config = '{'
            +'"tablename":"dw_user",'                   //数据表名
            +'"fields":["uid","username","salt","psd"],'//关键字段名，依次分别为用户id,用户名，盐，密码
            +'"successurl":"/bbs",'                     //成功后跳转的URL
            +'"cookie":["bbs_user","bbs123"],'          //成功后写入的COOKIE名称,和加密字符串
            +'"error":"注册信息错误，请重新输入"'
            +'}';

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
    joConfig    : Variant;
    joUser      : Variant;
    //
    iUid        : Integer;
    sName       : String;
    sPassword   : String;
    sSalt       : String;
    sCookie     : string;
    sValue      : string;
    sInfo       : string;
    bRegister   : Boolean;
begin
    //检查配置文件是否合法的JSON字符串.如果不是,则提示,退出
    if not dwStrIsJson(_config) then begin
        dwMessage('配置信息不正确,请检查!','error',self);
        Exit;
    end;
    if Length(Trim(Edit_User.Text))<4 then begin
        dwMessage('用户名不能少于4个字符!','error',self);
        Exit;
    end;
    if Length(Trim(Edit_Password.Text))<6 then begin
        dwMessage('密码不能少于6个字符!','error',self);
        Exit;
    end;
    if lowercase(Edit_Captcha.Text) <> lowercase(dwGetProp(Image_Captcha,'captcha')) then begin
        dwMessage('验证码不正确,请重新输入!','error',self);
        Exit;
    end;
    if Edit_Password.Text <> Edit_Confirm.Text then begin
        dwMessage('密码和确认密码不一致!','error',self);
        Exit;
    end;


    //创建配置JSON对象,以备后面使用
    joConfig    := _JSON(_config);

    try
        //设置注册标识默认为未注册
        bRegister   := False;


        //在数据表中内查询
        ADOQuery1.Close;
        ADOQuery1.SQL.Text   := 'SELECT ['+joConfig.fields._(1)+'] '
                +' FROM '+joConfig.tablename
                +' WHERE ('+joConfig.fields._(1)+'='''+Trim(Edit_User.Text)+''')';
                    // or (email='''+Edit_Mail.Text+''')';
        ADOQuery1.Open;

        //检查
        if ADOQuery1.IsEmpty then begin
            //
            sSalt       := FormatDateTime('YYYYMMDDhhmmsszzz',Now);
            sPassword   := dwGetMD5(dwGetMD5(Edit_Password.Text)+sSalt);
            sName       := Trim(Edit_User.Text);

            //
            ADOQuery1.close;
            ADOQuery1.SQL.Text  := 'INSERT INTO '+joConfig.tablename
                    +' (username,salt,psd)'
                    +' VALUES('''+sName+''','''+sSalt+''','''+sPassword+''')';
            ADOQuery1.ExecSQL;

            //取得当前UID
            ADOQuery1.close;
            ADOQuery1.SQL.Text  := 'SELECT uid FROM '+joConfig.tablename+' WHERE username='''+sName+'''';
            ADOQuery1.Open;
            iUid    := ADOQuery1.FieldByName('uid').AsInteger;


            //把注册数据保存在JSON字符串中,以便写入更多数据, 如id等
            joUser  := _json('{}');
            joUser.uid      := iUid;
            joUser.name     := sName;
            joUser.logindate:= dwDateToPHPDate(Now);
            sInfo   := joUser;

            //写入cookie. 对写入值进行加密
            sCookie := joConfig.cookie._(0);
            sValue  := joConfig.cookie._(1);
            sValue  := dwAESEncrypt(sInfo,sValue);
            dwSetCookie(self,sCookie,sValue,30*24);

            //下面是检查验证码. 验证码可点击自动切换
            dwOpenUrl(self,'/bbs','_self');
        end else begin
            dwMessage(joConfig.error,'error',self);
        end;
    except
        dwMessage('配置信息不正确,请检查!','error',self);
        Exit;
    end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    //
    if (X>600)and(Y>600) then begin
        dwSetPCMode(self);
    end else begin
        Image_bg.Visible    := False;
        dwSetMobileMode(self,360,720);
        Panel_Login.Top     := 0;
        Panel_Login.Height  := Self.Height;
        Image_Logo.Margins.Top  := 30;
    end;
end;

end.
